Attribute VB_Name = "mdlPath"
Option Explicit

Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
Public Const BLACKNESS = &H42
Public Const WHITENESS = &HFF0062

Public Type typePathItem
 x As Byte
 y As Byte
End Type

Public Type typePathInfo
 IsHedge(1 To 16, 1 To 10) As Byte
 StartPoint As typePathItem
 EndPoint As typePathItem
 PathLength As Byte
 PathDat(1 To 128) As typePathItem
End Type

Private Type typeNodeItem
 Depth As Byte
 Cost As Single
 LastNode As typePathItem
 NextNode As typePathItem
 Went As Byte
End Type

Public Function AStar(dat As typePathInfo) As Boolean
Dim NodeData(1 To 16, 1 To 10) As typeNodeItem
Dim FirstNode As typePathItem
Dim StartNode As typePathItem
Dim EndNode As typePathItem
Dim EmptyNode As typePathItem
Dim i As Integer, j As Integer
Dim x As Integer, y As Integer
'///////////////////////////////////////Play Move Sound
i = Int(3 * Rnd)
sPlay i + 2
'///////////////////////////////////////End
EmptyNode.x = 0
EmptyNode.y = 0
FirstNode = dat.StartPoint
StartNode = dat.StartPoint
EndNode = dat.EndPoint
With NodeData(StartNode.x, StartNode.y)
 .Depth = 0
 .Cost = CalcCost(StartNode.x, StartNode.y, EndNode.x, EndNode.y)
 .LastNode = EmptyNode
 .NextNode = EmptyNode
 .Went = 1
End With
Do
 If StartNode.x = 0 And StartNode.y = 0 Then AStar = False: dat.PathLength = 0: Exit Function
 If StartNode.x = EndNode.x And StartNode.y = EndNode.y Then Exit Do
 FirstNode = NodeData(StartNode.x, StartNode.y).NextNode
 For i = -1 To 1
  For j = -1 To 1
   x = StartNode.x + i
   y = StartNode.y + j
   If x >= 1 And x <= 16 And y >= 1 And y <= 10 Then
    If NodeData(x, y).Went = 0 And _
    dat.IsHedge(x, y) = 0 Then
     InsertNodeAndCalc NodeData, x, y, _
     NodeData(StartNode.x, StartNode.y).Depth, StartNode.x, StartNode.y, _
     FirstNode, EndNode
    End If
   End If
  Next j
 Next i
 StartNode = FirstNode
Loop
dat.PathLength = NodeData(EndNode.x, EndNode.y).Depth
For i = dat.PathLength To 1 Step -1
 StartNode = EndNode
 dat.PathDat(i) = EndNode
 EndNode = NodeData(StartNode.x, StartNode.y).LastNode
Next i
AStar = True
End Function

Public Function CalcCost(ByVal X1 As Integer, ByVal y1 As Integer, ByVal x2 As Integer, ByVal y2 As Integer) As Single 'As Byte
Dim d1 As Integer, d2 As Integer
d1 = Abs(X1 - x2)
d2 = Abs(y1 - y2)
'CalcCost = IIf(d1 > d2, d1, d2)
CalcCost = Sqr(d1 * d1 + d2 * d2)
End Function

Private Sub InsertNodeAndCalc(dat() As typeNodeItem, ByVal x As Byte, ByVal y As Byte, ByVal Depth As Byte, ByVal lx As Byte, ByVal ly As Byte, sNode As typePathItem, eNode As typePathItem)
Dim i As Integer
Dim oNode As typePathItem, nNode As typePathItem
dat(x, y).Cost = CalcCost(x, y, eNode.x, eNode.y)
'///////////////////////////extra
If GData.LevelData(x, y) = 3 Then
 dat(x, y).Cost = dat(x, y).Cost + IIf(IsRecord, wR(0), Weight(0))
ElseIf GData.LevelData(x, y) = 2 Then
 dat(x, y).Cost = dat(x, y).Cost + IIf(IsRecord, wR(1), Weight(1))
End If
If GData.LevelLaser(x, y) > 0 Then
 dat(x, y).Cost = dat(x, y).Cost + IIf(IsRecord, wR(2), Weight(2))
End If
'///////////////////////////
dat(x, y).Depth = Depth + 1
dat(x, y).LastNode.x = lx
dat(x, y).LastNode.y = ly
dat(x, y).Went = 1
'//////////////////////////Add node
If sNode.x = 0 And sNode.y = 0 Then
 dat(x, y).NextNode.x = sNode.x
 dat(x, y).NextNode.y = sNode.y
 sNode.x = x
 sNode.y = y
ElseIf dat(x, y).Cost + dat(x, y).Depth < dat(sNode.x, sNode.y).Cost + _
dat(sNode.x, sNode.y).Depth Then
 dat(x, y).NextNode.x = sNode.x
 dat(x, y).NextNode.y = sNode.y
 sNode.x = x
 sNode.y = y
Else
 oNode = sNode
 Do
  nNode = dat(oNode.x, oNode.y).NextNode
  If nNode.x = 0 And nNode.y = 0 Then Exit Do
  If dat(x, y).Cost + dat(x, y).Depth < _
  dat(nNode.x, nNode.y).Cost + dat(nNode.x, nNode.y).Depth Then
   dat(oNode.x, oNode.y).NextNode.x = x
   dat(oNode.x, oNode.y).NextNode.y = y
   dat(x, y).NextNode = nNode
   Exit Sub
  End If
  oNode = nNode
 Loop
 dat(oNode.x, oNode.y).NextNode.x = x
 dat(oNode.x, oNode.y).NextNode.y = y
 dat(x, y).NextNode.x = 0
 dat(x, y).NextNode.y = 0
End If
End Sub
